home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO004.dsk / REPORT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  17KB  |  365 lines
  1. 10  REM  <<< FILE CABINET >>>
  2. 20  REM   <<< REPORT ROUTINE >>>  
  3. 30  REM   <<< PRODOS VERSION >>>
  4. 40  REM   <<< UPDATED BY     >>>
  5. 50  REM   <<< MICHAEL MOORE  >>>
  6. 60  REM   <<<   MAY 1984     >>>  
  7. 1000  GOTO 15010: REM  START POINT
  8. 2000  REM  <<< PRINT SETUP >>>
  9. 2010  PRINT D$"PR#1": PRINT  CHR$(18);: PRINT  CHR$(27) + CHR$(70);
  10. 2020  ON PF GOTO 2030,2050
  11. 2030  PRINT  CHR$(9)"80N";: PRINT  CHR$(27) + CHR$(69): RETURN 
  12. 2050  PRINT  CHR$(9)"132N";: PRINT  CHR$(15);: RETURN 
  13. 2090  REM  <<< REM PRINT SETUP >>>
  14. 2100  PRINT :L$ = "PRINT SET-UP CORRECT ": GOSUB 2510: IF YES = 1  THEN  GOTO 2110
  15. 2105  IF YES = 0  THEN  POP : GOTO 22010
  16. 2110  PRINT : INVERSE : PRINT  TAB( 10)"TURN YOUR PRINTER ON" SPC( 10)" ": NORMAL : PRINT 
  17. 2120  INPUT "PRESS <RETURN> WHEN READY...";R$: RETURN 
  18. 2410  PRINT L$"->":V =  PEEK(37)::H =  LEN(L$) +3
  19. 2420  VTAB V: HTAB H: CALL  -868: INPUT "";R$:R =  VAL(R$): CALL  -958
  20. 2430  IF R <1  OR R >CHOICE  THEN 2450
  21. 2440  PRINT : RETURN 
  22. 2450  IF V = 23  THEN V = 22
  23. 2460  CALL  -868: PRINT " ENTER NUMBER 1 THRU ";CHOICE: GOTO 2420
  24. 2480  IF SEP = 1  THEN  RETURN 
  25. 2482  HOME : PRINT : PRINT "SPACING FOR PRINTED FORMAT": PRINT 
  26. 2483  PRINT  TAB( 3)"<1> SKIP BLANK LINE BETWEEN RECORDS"
  27. 2484  PRINT  TAB( 3)"<2> RECORDS PRINTED THEN BLANK LINE"
  28. 2485  PRINT  TAB( 3)"<3> RECORDS PRINTED THEN BLANK LINE"
  29. 2486  PRINT  TAB( 3)"<4> RECORDS PRINTED THEN BLANK LINE"
  30. 2487  PRINT  TAB( 3)"<5> RECORDS PRINTED THEN BLANK LINE"
  31. 2489  PRINT : PRINT  TAB( 7)"WHICH ->:";: CALL  -868: INPUT "";LC
  32. 2490  IF LC <1  OR LC >5 GOTO 2480
  33. 2493  IF LC = 1  THEN LT = 30
  34. 2494  IF LC = 2  THEN LT = 40
  35. 2495  IF LC = 3  THEN LT = 45
  36. 2496  IF LC = 4  THEN LT = 48
  37. 2497  IF LC = 5  THEN LT = 50
  38. 2499  RETURN 
  39. 2510 V =  PEEK(37) +1
  40. 2515  PRINT L$" (Y/N)"
  41. 2520  IF V >23  THEN V = 23
  42. 2530  VTAB V: HTAB ( LEN(L$) +8): CALL  -868: INPUT A$: IF A$ = "Y"  THEN YES = 1: RETURN 
  43. 2540  IF A$ = "N"  THEN YES = 0: RETURN 
  44. 2550  INVERSE : PRINT " PRESS 'Y' OR 'N'...": NORMAL : IF V =  >23  THEN V = 22
  45. 2560  GOTO 2530
  46. 9000  REM  <<< SUBROUTINE >>
  47. 9010  IF (PF)  OR (AR)  THEN 9030
  48. 9020  PRINT "PRESS RETURN TO CONTINUE, ESC TO ABORT";: GOTO 9050
  49. 9030 LF =  PEEK( -16384): POKE  -16368,0
  50. 9040  ON LF = 141 GOTO 9050: ON LF = 155 GOTO 9070: GOTO 9090
  51. 9050 LF =  PEEK( -16384): IF LF <128  THEN 9050
  52. 9060  POKE  -16368,0
  53. 9070  IF LF = 155  THEN LF = 1: GOTO 9100
  54. 9080  IF LF < >141  THEN 9050
  55. 9090 LF = 0
  56. 9100  IF PF = 0  AND AR = 0  THEN  PRINT :L = 0: HOME 
  57. 9110  RETURN 
  58. 15010  HOME :E = 0:WIDE = 0:L%(0) = 4:HR = 0
  59. 15020  FOR I = 0 TO (NH +1) *3:K(I) = 0: NEXT I:L%(NH +1) = 0:PAGE = 0:TF = 0
  60. 15030  FOR I = 1 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0: ON E GOTO 15500: GOTO 22010
  61. 15100  POKE 34, PEEK(37) +2: HOME : IF E = 0  THEN  INPUT "ENTER REPORT FORMAT NAME (NO LONGER THAN 9 LETTERS) :";RN$(NN)
  62. 15120  FOR I = 1 TO NH +1:K(I *3 -2) = 0:K(I *3 -1) = 0:K(I *3) = 0: VTAB I: HTAB 31: CALL  -868: NEXT I: CALL  -958:K(0) = 0: HOME 
  63. 15130 RH = 0: INPUT "ENTER TAB FOR LEFT MARGIN (=>1) ";K$:L =  VAL(K$): IF L <1  THEN L = 1
  64. 15140  FOR I = 1 TO (NH +1) *3  STEP 3
  65. 15150  HOME :V =  PEEK(37) +1: VTAB 23: INVERSE : PRINT "PRESS <RETURN> ALONE TO EXIT FORMAT...": NORMAL 
  66. 15155  VTAB V: PRINT "ENTER HEADER # FOR POSITION #"(I +2)/3" ";: INPUT "";K$: CALL  -958: IF   NOT  LEN(K$)  THEN I = (NH +1) *3: GOTO 15220
  67. 15160 K(I) =  VAL(K$): IF K(I) <0  OR K(I) >NH  THEN 15150
  68. 15180  PRINT :L$ = "TOTAL ON " +H$(K(I)): GOSUB 2510: CALL  -958: PRINT : IF YES  THEN K(I +2) = 1:K(0) = 1:TF = 1:L = L +2: GOTO 15190
  69. 15185 L$ = "RIGHT JUSTIFY DATA?": GOSUB 2510: IF YES  THEN K(I +2) = 2
  70. 15190 K(I +1) = L:L = L +L%(K(I)) +2:WIDE = L -2:RH = RH +1
  71. 15200  VTAB K(I) +1: HTAB 32: PRINT (I +2)/3 TAB( 36)K(I +1);: IF K(I +2) = 1  THEN  PRINT  TAB( 39)"T";
  72. 15202  IF K(I +2) = 2  THEN  PRINT  TAB( 39)"F";
  73. 15205  PRINT : IF WIDE >131 -(10 *K(0))  THEN ER = 1:I = (NH +1) *3
  74. 15220  NEXT I:I = RH *3 +1: IF   NOT ER  THEN 15250
  75. 15230 ER = 0: HOME : PRINT "  THIS REPORT IS TOO WIDE!":L$ = "TRY AGAIN?": GOSUB 2510: ON YES GOTO 15120: TEXT : GOTO 28010
  76. 15250 V = NH +2: ON K(0) = 0 GOTO 15300: HOME :L$ = "GRAND TOTAL?": GOSUB 2510:V = NH +2: IF   NOT YES  THEN K(0) = 0: GOTO 15300
  77. 15252  FOR J = 1 TO (NH +1) *3  STEP 3: ON K(J +2) = 1 GOTO 15254: GOTO 15264
  78. 15254  HOME : PRINT "ADD OR SUBTRACT ";: INVERSE : PRINT H$(K(J)): NORMAL : PRINT "TO/FROM GRAND TOTAL (A/S) ";: INPUT A$
  79. 15256  IF A$ = "A"  THEN K(J +2) = 1:A$ = "+T": GOTO 15262
  80. 15258  IF A$ = "S"  THEN K(J +2) =  -1:A$ = "-T": GOTO 15262
  81. 15260  GOTO 15254
  82. 15262  VTAB K(J) +1: HTAB 38: PRINT A$
  83. 15264  NEXT J
  84. 15270  FOR J = 1 TO RH: IF K(3 *J) = 1  OR K(3 *J) =  -1  THEN  IF L%(K(3 *J -2)) >L%(NH +1)  THEN L%(NH +1) = L%(K(3 *J -2)) +1
  85. 15275  NEXT J
  86. 15280 WIDE = L +L%(NH +1): IF WIDE >131  THEN 15230
  87. 15290 K(I) = NH +1:K(I +1) = L: VTAB V: PRINT "TOTAL" TAB( 32)RH +1 TAB( 36)K(I +1) +1:V = V +1
  88. 15300  VTAB V: PRINT "RIGHT MARGIN" TAB( 36)WIDE -1
  89. 15310  HOME :L$ = "IS THIS SATISFACTORY?": GOSUB 2510: ON YES GOTO 15500: GOTO 15120
  90. 15500  TEXT : IF TF  THEN TF = 0: PRINT : GOSUB 27010
  91. 15505  GOSUB 21010
  92. 15507  POKE 34, PEEK(37) +1: HOME 
  93. 15508 L$ = "FIRST COLUMN ONLY (IF ALPHA),           SEPARATE DIFFERENT LETTERS?": GOSUB 2510:SEP = 0: IF YES  THEN SEP = 1
  94. 15509  POKE 34, PEEK(37) -2: HOME 
  95. 15510 L$ = "SELECT ALL RECORDS?": GOSUB 2510: IF YES  THEN Q$ = "ALL": GOTO 15620
  96. 15520  HOME : INPUT "SELECT RECORDS BY WHICH HEADER #";S$:S =  VAL(S$): IF S <0  OR S >NH  THEN  PRINT  CHR$(7): GOTO 15520
  97. 15530  VTAB S +3: HTAB 20: INVERSE : PRINT "1ST": NORMAL 
  98. 15535  HOME :L$ = "'OR' 2ND HEADER?": GOSUB 2510: CALL  -958: IF   NOT YES  THEN 15560
  99. 15540  PRINT : INPUT "ENTER # OF 'OR' HEADER ->";K$:K =  VAL(K$): IF K <0  OR K >NH  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -958: GOTO 15540
  100. 15550 HR = 1: GOTO 15575
  101. 15560  HOME :L$ = "'AND' 2ND HEADER?": GOSUB 2510: CALL  -958: IF   NOT YES  THEN K$ = "NO":HR = 1: GOTO 15590
  102. 15570  PRINT : INPUT "ENTER # OF 'AND' HEADER ->";K$:K =  VAL(K$):HR = 2: IF K <0  OR K >NH  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -958:HR = 0: GOTO 15570
  103. 15575  IF K = S  THEN  VTAB S +3: HTAB 20: FLASH : PRINT "1ST": NORMAL :V = HR:HR = 0:K$ = "": ON V GOTO 15535,15560
  104. 15580  VTAB K +3: HTAB 20: INVERSE : IF HR = 1  THEN  PRINT "'OR' 2ND": GOTO 15590
  105. 15585  PRINT "'AND' 2ND"
  106. 15590  NORMAL : HOME : PRINT "ENTER RECORDS TO REPORT FOR "H$(S)"=";: INPUT Q$: PRINT : IF  LEN(Q$) = 0  THEN Q$ = "@"
  107. 15600  ON K$ = "NO" GOTO 15620: IF HR = 1  THEN  PRINT "OR ";: GOTO 15615
  108. 15610  PRINT "AND ";
  109. 15615  PRINT H$(K)"=";: CALL 768,K$: IF  LEN(K$) = 0  THEN K$ = "@"
  110. 15620  TEXT : HOME : IF WIDE  THEN 15630
  111. 15622  FOR J = 1 TO RH: IF K(3 *J) = 1  OR K(3 *J) =  -1  THEN  IF L%(K(3 *J -2)) >L%(NH +1)  THEN L%(NH +1) = L%(K(3 *J -2)) +1
  112. 15624  NEXT J
  113. 15626 WIDE = K(RH *3 -1) +L%(K(RH *3 -2)): IF K(RH *3 +2)  THEN WIDE = K(RH *3 +2) +L%(NH +1)
  114. 15630  IF PF  THEN PF = 1 +(WIDE >79): GOTO 15646
  115. 15632  IF   NOT PF GOTO 15661
  116. 15635  IF WIDE <40  THEN 15660
  117. 15640  PRINT  CHR$(7)"THIS REPORT IS TOO WIDE FOR THE MONITOR": PRINT "SCREEN.  DO YOU WANT YOUR PRINTER":L$ = "ON? ": GOSUB 2510: IF   NOT YES  THEN  POKE 34,0: GOTO 15800
  118. 15645 T = S:S = 0: GOSUB 29010:S = T: GOTO 15630
  119. 15646  HOME : PRINT : PRINT "CONTINUOUS REPORT WITHOUT SPACING":L$ = "BETWEEN THE LINES?": GOSUB 2510:LC = 0:LT = 60: IF YES = 0  THEN  GOSUB 2480
  120. 15650  PRINT : INPUT "ENTER PAGE # OF FIRST PAGE -> ";R$:PAGE =  VAL(R$) -1: IF PAGE <0  THEN PAGE = 0
  121. 15655  GOSUB 2100
  122. 15660  IF PF = 0  THEN  GOSUB 2480
  123. 15661  TEXT : HOME : FOR I = 1 TO RH:AC(I) = 0
  124. 15662  IF K(3 *I) = 1  THEN T9 = 1
  125. 15665  NEXT I
  126. 15670  IF PF  THEN  GOSUB 2010
  127. 15675  GOSUB 18010
  128. 15679 LS = 1
  129. 15680  FOR J = 1 TO NR:Y = R(J)
  130. 15685 N$(Y,0) =  STR$(J)
  131. 15690  IF Q$ = "ALL"  THEN 15760
  132. 15695  ON HR GOTO 15705,15740
  133. 15705  IF Q$ = "@"  AND  LEN(N$(Y,S)) >0  THEN 15760
  134. 15710  IF  LEFT$(N$(Y,S), LEN(Q$)) = Q$  THEN 15760
  135. 15715  IF K$ = "NO"  THEN 15765
  136. 15720  IF K$ = "@"  AND  LEN(N$(Y,K)) >0  THEN 15760
  137. 15725  IF  LEFT$(N$(Y,K), LEN(K$)) < >K$  THEN 15765
  138. 15730  GOTO 15760
  139. 15740  IF Q$ = "@"  AND  LEN(N$(Y,S)) >0  THEN 15750
  140. 15745  IF  LEFT$(N$(Y,S), LEN(Q$)) < >Q$  THEN 15765
  141. 15750  IF K$ = "@"  AND  LEN(N$(Y,K)) >0  THEN 15760
  142. 15755  IF  LEFT$(N$(Y,K), LEN(K$)) < >K$  THEN 15765
  143. 15760  GOSUB 16010
  144. 15762  IF LS = LC  THEN  PRINT :LS = 0
  145. 15765  IF PF <1  THEN  IF LN >16  THEN  GOSUB 9010: IF   NOT LF  AND J <NR  THEN  GOSUB 18010:LS = 1: GOTO 15780
  146. 15770  IF LF  THEN J = NR: GOTO 15780
  147. 15775  IF J <NR  AND LN >LT  THEN  GOSUB 18010
  148. 15779 LS = LS +1
  149. 15780  NEXT J
  150. 15785  IF LF  THEN LF = 0: PRINT : GOTO 15795
  151. 15790  ON T9 GOSUB 17020
  152. 15795  PRINT : PRINT D$"PR#0"
  153. 15800  ON E GOTO 15815
  154. 15805  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT":L$ = "FOR THIS REPORT TO DISK ": GOSUB 2510
  155. 15810  IF YES  THEN E = 1: GOSUB 19010
  156. 15815  POKE 216,0: PRINT : PRINT "MORE REPORTS USING THE "RN$(NN):L$ = "FORMAT ": GOSUB 2510
  157. 15820  IF YES  THEN E = 1:PAGE = 0:LC = 0: GOTO 15030
  158. 15825  GOTO 22010
  159. 16010  FOR I = 1 TO RH: ON  ABS(K(3 *I)) GOTO 16100,16030
  160. 16015  IF SEP = 1  AND J < >1  AND I = 1  THEN  IF  LEFT$(N$(Y,K(3 *I -2)),1) < > LEFT$(N$(R(J -1),K(3 *I -2)),1)  THEN  PRINT 
  161. 16020  POKE 36,K(3 *I -1): PRINT N$(Y,K(3 *I -2));: GOTO 16040
  162. 16030  POKE 36,K(3 *I -1) +L%(K(3 *I -2)) - LEN(N$(Y,K(3 *I -2))): PRINT N$(Y,K(3 *I -2));
  163. 16040  NEXT I
  164. 16050  IF K(0) < >1  OR HC = 0  THEN 16080
  165. 16060 DT = HC:T = 0: GOSUB 27510
  166. 16070  POKE 36,T: PRINT DT$;:GT = GT +HC:HC = 0
  167. 16080 LN = LN +1: PRINT : RETURN 
  168. 16100 N = 3 *I -2: IF  LEN(N$(Y,K(N))) = 0  THEN 16040
  169. 16110 DT =  VAL(N$(Y,K(N))):T = 0: GOSUB 27510:V =  VAL(DT$): POKE 36,T: PRINT DT$;:AC(I) = AC(I) +V:HC = HC +(V *K(3 *I)): GOTO 16040
  170. 17010  POKE 36,K(2): FOR I = K(2) TO WIDE -1: PRINT "-";: NEXT I: PRINT : RETURN 
  171. 17020  GOSUB 17010: FOR I = 1 TO RH: IF AC(I) = 0  THEN 17070
  172. 17050 DT = AC(I):T = 0: GOSUB 27510: POKE 36,T: PRINT DT$;
  173. 17070  NEXT I
  174. 17080  ON GT = 0 GOTO 17090:DT = GT:T = 0: GOSUB 27510: POKE 36,T: PRINT DT$;
  175. 17090  PRINT : RETURN 
  176. 18010  HOME : IF LN  AND  LEN(TD$) >0  THEN  PRINT  CHR$(12)
  177. 18012 LS = 0
  178. 18015 T = (WIDE +K(2))/2 - LEN(FD$) -8: IF T <1  THEN T = 1
  179. 18020 LN = 0: POKE 36,T: PRINT  CHR$(14) +FD$" DATA BASE":LN = LN +1
  180. 18030  POKE 36,K(2): PRINT RN$(NN)" REPORT FOR ";: IF Q$ = "ALL"  THEN  PRINT "ALL RECORDS":LN = LN +1: GOTO 18110
  181. 18040  PRINT H$(S)" ";: IF Q$ < >"@"  THEN  PRINT ": "Q$;
  182. 18050  IF K$ = "NO"  THEN  PRINT :LN = LN +1: GOTO 18110
  183. 18060  PRINT :LN = LN +1
  184. 18070  IF HR = 1  THEN  POKE 36,K(2): PRINT "OR ";
  185. 18080  IF HR = 2  THEN  POKE 36,K(2): PRINT "AND ";
  186. 18090  PRINT H$(K);: IF K$ < >"@"  THEN  PRINT ": "K$;
  187. 18100  PRINT :LN = LN +1
  188. 18110 PAGE = PAGE +1: POKE 36,T: PRINT TD$;
  189. 18115  IF   NOT PF  THEN  PRINT : GOTO 18130
  190. 18120  POKE 36,WIDE -5 - LEN( STR$(PAGE)): PRINT "PAGE "PAGE:LN = LN +1
  191. 18130  GOSUB 17010
  192. 18140  FOR I = 1 TO RH
  193. 18150  POKE 36,K(3 *I -1): PRINT H$(K(3 *I -2));
  194. 18160  NEXT I
  195. 18170  IF K(0) = 1  THEN  POKE 36,K(3 *I -1) +3: PRINT "TOTAL";
  196. 18180  PRINT : GOSUB 17010
  197. 18190 LN = LN +3: RETURN 
  198. 19000  REM  <<<< WRITE FILES >>>
  199. 19010 NS = NR
  200. 19020  PRINT 
  201. 19030 F$ = "RPTFMT" +RN$(NN)
  202. 19040 NR = 3 *RH +3
  203. 19050  FOR I = 1 TO NR:R$(I) =  STR$(K(I)): NEXT I
  204. 19060 R$(I -3) =  STR$(K(0))
  205. 19070 R$(I -1) =  STR$(FT)
  206. 19080  GOSUB 24010: GOSUB 25010
  207. 19090  RETURN 
  208. 20000  REM  <<< READ FILES >>>
  209. 20010 F$ = "RPTFMT" +RN$(NN)
  210. 20020  GOSUB 23010
  211. 20030 RH = (NR -3)/3: FOR I = 1 TO NR:K(I) =  VAL(R$(I)): NEXT I
  212. 20040 K(0) =  VAL(R$(I -3)):K(I -3) = NH +1
  213. 20050 FT =  VAL(R$(I -1))
  214. 20060 NR = NS
  215. 20070  GOSUB 21010: PRINT : GOTO 15508
  216. 21000  REM   <<SELECT FROM >>>
  217. 21010  HOME : PRINT "SELECT FROM:": PRINT 
  218. 21020  IF MF = 0  THEN  PRINT "O "H$(0)
  219. 21030  FOR I = 1 TO NH: PRINT I" "H$(I): NEXT I: PRINT 
  220. 21040 MF = 0
  221. 21050  RETURN 
  222. 22010 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  223. 22020 F$ = "RPTFMTNAME"
  224. 22030  ONERR  GOTO 22160
  225. 22035  PRINT D$;"VERIFY";PB$ +FD$ +"/" +F$
  226. 22040  GOSUB 23010
  227. 22050  POKE 216,0
  228. 22060  FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  229. 22070  HOME : PRINT "SELECT FROM:": PRINT 
  230. 22080  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  231. 22090  PRINT I" CREATE A NEW REPORT FORMAT"
  232. 22100  PRINT I +1" DELETE A REPORT FORMAT": PRINT I +2" RETURN TO THE MAIN ROUTINE": PRINT 
  233. 22104  PRINT I +3" CHANGE PRINTER STATUS"
  234. 22106  PRINT "       CURRENT STATUS IS ";: IF PF  THEN  INVERSE : PRINT "ON": NORMAL : GOTO 22110
  235. 22108  INVERSE : PRINT "OFF": NORMAL : PRINT 
  236. 22110 L$ = "WHICH ":CHOICE = I +3: GOSUB 2410:S = R
  237. 22115  IF S = I +2  THEN NR = NS: GOTO 28010
  238. 22116  IF S = I +3  THEN  GOSUB 29110: GOTO 22070
  239. 22120 NN = S
  240. 22130  IF S <I  THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 20010
  241. 22140  IF S = I +1  THEN 30010
  242. 22150  GOTO 22200
  243. 22160  CALL 1013: HOME : PRINT "NO REPORT FORMATS ON DISK...": PRINT 
  244. 22170  POKE 216,0
  245. 22180 NN = 1
  246. 22190 L$ = "DO YOU WANT TO CREATE ONE": GOSUB 2510: IF   NOT YES  THEN NR = 0: GOTO 30100
  247. 22200  HOME : GOSUB 21020:NR = NS:E = 0: GOTO 15100
  248. 23000  REM   << READ  FILE  >>
  249. 23010 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  250. 23015 Q$ = PB$ +FD$ +"/" +F$
  251. 23020  PRINT D$"OPEN"Q$
  252. 23030  PRINT D$"READ"Q$
  253. 23040  INPUT NR
  254. 23050  FOR J = 1 TO NR
  255. 23060  ON FF GOTO 23130
  256. 23070  FOR I = 1 TO NH
  257. 23080  CALL 768,N$(J,I)
  258. 23090 L =  LEN(N$(J,I)): IF L >L%(I)  THEN L%(I) = L
  259. 23100  NEXT I
  260. 23110 R(J) = J
  261. 23120  GOTO 23140
  262. 23130  CALL 768,R$(J)
  263. 23140  NEXT J
  264. 23150  PRINT D$"CLOSE"
  265. 23160 FF = 0
  266. 23170  RETURN 
  267. 24010 NR$ =  RIGHT$("00000" + STR$(NR),5)
  268. 24020 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  269. 24025  ONERR  GOTO 60010
  270. 24030 Q$ = PB$ +FD$ +"/" +F$
  271. 24040  PRINT D$"OPEN"Q$: PRINT D$"WRITE"Q$
  272. 24050  PRINT NR$
  273. 24060  FOR J = 1 TO NR
  274. 24070  ON FF GOTO 24130
  275. 24080 Y = R(J)
  276. 24090  FOR I = 1 TO NH
  277. 24100  PRINT N$(Y,I)
  278. 24110  NEXT I
  279. 24120  GOTO 24140
  280. 24130  PRINT R$(J)
  281. 24140  NEXT J
  282. 24150  PRINT D$"CLOSE"
  283. 24160 FF = 0
  284. 24170  RETURN 
  285. 25010 NR = NN:I = 0
  286. 25020 F$ = "RPTFMTNAME"
  287. 25030 I = I +1: IF I <NR  AND RN$(NN) = RN$(I)  THEN NR = NR -1
  288. 25035 R$(I) = RN$(I): IF I <NR  THEN 25030
  289. 25040  GOSUB 24010
  290. 25050 NR = NS: RETURN 
  291. 27010  HOME : PRINT "SELECT NUMERICAL FORMAT:": PRINT 
  292. 27020  PRINT "1. INTEGER           X"
  293. 27030  PRINT "2. 1 DECIMAL PLACE   X.X"
  294. 27040  PRINT "3. 2 DECIMAL PLACES  X.XX"
  295. 27050  PRINT :L$ = "WHICH ":CHOICE = 3: GOSUB 2410: PRINT 
  296. 27060 FT = R: RETURN 
  297. 27510  IF   NOT FT  THEN 27620
  298. 27520  ON FT GOTO 27530,27540,27550
  299. 27530 DT =  SGN(DT) * INT( ABS(DT) +.5): GOTO 27560
  300. 27540 DT =  SGN(DT) * INT( ABS(DT) *10 +.5)/10:T = T -2: GOTO 27560
  301. 27550 DT =  SGN(DT) * INT( ABS(DT) *100 +.5)/100:T = T -3
  302. 27560 P1 =  INT( ABS(DT)): IF DT <0  THEN T = T -1
  303. 27570 P2 =  INT(( ABS(DT) -P1) *100 +.5):DT$ = ""
  304. 27580  FOR L = 1 TO L%(K(3 *I -2)) -1:T = T +(P1 < INT(10 ^L)): NEXT 
  305. 27590 DT$ =  STR$( ABS(DT)): IF P1 = 0  THEN DT$ = "0" +DT$
  306. 27595  IF DT <0  THEN DT$ = "-" +DT$
  307. 27597  ON FT = 1 GOTO 27620
  308. 27600  IF P2 = 0  THEN DT$ = DT$ +".0": IF FT = 3  THEN DT$ = DT$ +"0": GOTO 27620
  309. 27610  IF FT = 3  AND ( INT(P2/10) = P2/10)  THEN DT$ = DT$ +"0"
  310. 27620 T = K(3 *I -1) +T: RETURN 
  311. 28010  PRINT D$"CHAIN";PX$ +"MAIN"
  312. 29000  REM  <<< PRINT SET UP >>>
  313. 29010  PRINT "VERIFY THAT PRINTER IS TURNED ON"
  314. 29020  PRINT " PRESS ANY KEY WHEN READY": GET K$
  315. 29030 PF = 1
  316. 29040  RETURN 
  317. 29100  REM  <<< SET PRINTER MODE >>>
  318. 29110  IF PF  THEN PF = 0:LN = 0: GOTO 29130
  319. 29120 PF = 1
  320. 29130  RETURN 
  321. 30000  REM  << DELETE FILE >>>
  322. 30010  HOME : PRINT "SELECT FROM:": PRINT 
  323. 30020  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  324. 30030 L$ = "DELETE WHICH NUMBER ":CHOICE = I -1: GOSUB 2410:S = R
  325. 30040  HOME : VTAB 10: PRINT "YOU HAVE SELECTED THE OPTION TO DELETE": INVERSE : PRINT RN$(S)" FORMAT": NORMAL 
  326. 30050 L$ = "IS THIS CORRECT": GOSUB 2510: IF   NOT YES  THEN NR = NS: GOTO 28010
  327. 30060 F$ = "RPTFMT" +RN$(S)
  328. 30065 Q$ = PB$ +FD$ +"/" +F$
  329. 30070  PRINT D$"DELETE"Q$
  330. 30075  PRINT D$"CLOSE"
  331. 30080  IF S = NR  THEN 30100
  332. 30090  FOR I = S TO NR -1:RN$(I) = RN$(I +1): NEXT I
  333. 30100 NR = NR -1:F$ = "RPTFMTNAME": IF NR <1  THEN 30130
  334. 30110 I = 0: GOSUB 25030
  335. 30120  GOTO 22010
  336. 30130 Q$ = PB$ +FD$ +"/" +F$
  337. 30132  PRINT D$"CLOSE"
  338. 30133  ONERR  GOTO 30137
  339. 30135  PRINT D$"DELETE";Q$
  340. 30137  POKE 216,0
  341. 30140 NR = NS: GOTO 28010
  342. 60000  REM  <<< ERROR TRAP FOR INVALID INPUT>>>
  343. 60010  TEXT : HOME : VTAB 10
  344. 60020  PRINT "  INVALID INPUT": PRINT 
  345. 60030  PRINT "PRODOS REQUIRES THAT FILE NAMES BEGIN   WITH A LETTER AND CONTAIN ONLY LETTERS,NUMBERS OR PERIODS."
  346. 60040  PRINT : PRINT "NO SPACES ARE PERMITTED. NAMES MUST NOT EXCEED 15 CHARACTERS - INCLUDING ANY    ASSIGNED BY THE PROGRAM."
  347. 60045  PRINT "SIX CHARACTERS ARE ADDED BY THE PROGRAM WHEN SAVING REPORT NAMES."
  348. 60050  PRINT : PRINT "  PRESS ANY KEY TO RETURN TO REPORT MENU ";: GET K$
  349. 60060  POKE 216,0: GOTO 22010
  350. 61000  REM  *********************
  351. 61010  REM     FILE CABINET
  352. 61020  REM        PRODOS
  353. 61030  REM  ---------------------
  354. 61040  REM     CONVERTED BY
  355. 61050  REM     MICHAEL MOORE
  356. 61060  REM       MAY 1984
  357. 61070  REM  =====================
  358. 61080  REM         BASED ON
  359. 61090  REM   FILE CABINET-MACH 5
  360. 61100  REM     BY ED AYMOND
  361. 61110  REM   AND BOB MATZINGER   
  362. 61120  REM    AS A MODIFICATION
  363. 61130  REM   OF EARLIER VERSIONS  
  364. 61140  REM  *********************
  365. 61150  REM  APPLE CORPS OF DALLAS